perm filename MAINPR.OLD[PNT,HE]2 blob
sn#506097 filedate 1980-02-20 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00005 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 initial declarations and global variables
C00005 00003 ! getting to toplevel: chkesc_i,error
C00007 00004 ! system facilities: bailcode,qbailcode
C00009 00005 ! main program
C00011 ENDMK
C⊗;
comment initial declarations and global variables;
REQUIRE 300 STRING_PDL;REQUIRE 1000 SYSTEM_PDL;
REQUIRE 10000 STRING_SPACE;
DEFINE $MAINPR=TRUE ;
REQUIRE "HEADER.SAI" SOURCE_FILE;
IFC #DEBUG AND FALSE THENC
REQUIRE "PRINTX.HDR[AL,HE]" SOURCE_FILE;
! FOR PRINTING OUT RECORDS ;
! BAIL BUG REQUIRES FOLLOWING DUMMY PROCEDURE;
PROCEDURE BAIL_ANAMOLY;
BEGIN PRINTX(3); RECPRN(F_WRLD);TBLKSUPPRESS(NULL);SETRPM(0,0); END;
ENDC
LABEL MAINL; ! used by abort procedures to go to the top level;
DEFINE LOADMODULE(FILE) "<>" =
<
REQUIRE "FILE" LOAD_MODULE;
> ;
REQUIRE "<><>" DELIMITERS;
REQUIRE "FILES.REL" LOAD_MODULE;
REQUIRE "[][]" DELIMITERS;
! getting to toplevel: chkesc_i,error;
INTERNAL simple procedure esc_I;
$esc_I←true;
INTERNAL PROCEDURE CHKESC_I;
IF $ESC_I THEN
BEGIN
MTYDEVSTACK;
PRINT("
<ESCAPE> I termination
");
$ESC_I←FALSE; ENABLE(15); ! reset it again;
$ELFABORTED←TRUE;
GOTO MAINL;
END;
INTERNAL PROCEDURE ERROR(STRING ERR1,ERR2(NULL));
BEGIN
INTEGER I,J;
I ← LENGTH($CLINR); J ← LENGTH($CLNE);
PRINT($CLNE[1 TO J-I]&LF&$CLINR,CRLF);
PRINT (ERR1,ERR2,CRLF);
IFC #DISPL THENC
IF DEVICE≠DSK_X THEN $ALLOW←0; ! while reading display is not updated;
ENDC
ESC_P;
LODED($CLNE&CR); ! so it is possible to correct the command;
$CLINR←NULL; STOKEN←FALSE;
GO TO MAINL; ! goes to the main loop;
END;
! system facilities: bailcode,qbailcode;
IFC #DEBUG THENC
INTERNAL PROCEDURE BAILCODE;
BEGIN
GTOKEN(FALSE);
IF TOKEN="("
THEN BEGIN
INTEGER BRCHAR, COUNT;
COUNT←1;
DO BEGIN
IF (BRCHAR←READTILL("()"))="(" THEN COUNT←COUNT+1
ELSE COUNT←COUNT-1;
!!QUERY←!!QUERY&TOKEN&BRCHAR;
END UNTIL COUNT=0;
!!QUERY←!!QUERY[1 TO ∞-1];
END
ELSE STOKEN←TRUE;
BRK_N;
BAIL;
END;
INTERNAL PROCEDURE QBAILCODE;
BEGIN
!!query←READFILE("QUERY.TXT");
outstr("!!query ← """ & __query & """" & crlf);
bail;
end;
INTEGER !!i1,!!i2,!!i3,!!i4,!!i5,!!i6;
RANY !!r1,!!r2,!!r3,!!r4,!!r5,!!r6;
PROCEDURE DINIT;
BEGIN !!i1←!!i2←!!i3←!!i4←!!i5←!!i6←0;
!!r1←!!r2←!!r3←!!r4←!!r5←!!r6←null_record;
END;
REQUIRE DINIT INITIALIZATION;
ELSEC
INTERNAL PROCEDURE BAILCODE;
NOTAVAILCALL;
INTERNAL PROCEDURE QBAILCODE;
NOTAVAILCALL;
ENDC
! main program;
INTEGER RTIME;
WHILE TRUE DO
BEGIN
RTIME←RUNTIM;
PREPARSE; ! set up variables to parse one statement;
PARSE; ! parses the instruction;
CHKESC_I; ! check if escape_I was typed ;
IF NOT FINAL THEN SEMICOL_READ;
MAINL: STOKEN←FALSE;
IFC #WRIST THENC IF WSTPTR THEN RWRIST("READ"); ENDC
IF !LINE THEN PRINT(CRLF,"LAST STATEMENT: ",$CLNSAVE);
IF !PRTIME THEN PRINT(CRLF,"RUNTIME = ",RUNTIM-RTIME," MSECS");
END;